home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / LIBRARY / PAS_0793 / COLOUR.PAS < prev    next >
Pascal/Delphi Source File  |  1993-08-01  |  7KB  |  248 lines
  1. {─ Fido Pascal Conference ────────────────────────────────────────────── PASCAL ─
  2. Msg  : 363 of 375
  3. From : Rick Saunooke                       1:3641/1.0           01 Jul 93  23:52
  4. To   : All
  5. Subj : A Contribution - Part 1
  6. ────────────────────────────────────────────────────────────────────────────────
  7. What it is ?
  8.  
  9.          Well after lurking about for sometime I feel as though a
  10. contribution should be made. The following code segments will display
  11. some fire-works in 320x200 mode. Thought it would be appropriate so 
  12. close to the Fourth. I came across the code on a CD and made some
  13. changes, improvements I would think. The really kool part is that
  14. by modifying the data file you can create your own fx. If any of 
  15. you have any neato code for VGA loaders I would love to see it. 
  16. The code will follow in a total of seven parts. Parts 6 & 7 are
  17. the data file, name it "kablooie.kab".
  18.  
  19.                                             See Ya !
  20.                                             Rick Saunooke
  21.                                             Cherokee, NC - USA
  22.  
  23. ----------------------------[ Part 1 ]---------------------------}
  24. UNIT colour;
  25. INTERFACE
  26. TYPE
  27.  color=RECORD        { A palette 'cell' }
  28.   r,g,b: byte
  29.  END;
  30.  palette=ARRAY[0..255] OF color;   { a complete, 256-color palette }
  31.  
  32. CONST background=0; { index of palette corresponding to background }
  33.  black:      color=(r: 0;  g: 0;  b: 0 ); { list of standard colors }
  34.  grey10:     color=(r: 6;  g: 6;  b: 6 );
  35.  grey20:     color=(r: 13; g: 13; b: 13); { grayscale -- percentages }
  36.  grey30:     color=(r: 19; g: 19; b: 19);
  37.  grey40:     color=(r: 25; g: 25; b: 25);
  38.  grey50:     color=(r: 32; g: 32; b: 32);
  39.  grey60:     color=(r: 38; g: 38; b: 38);
  40.  grey70:     color=(r: 45; g: 45; b: 45);
  41.  grey80:     color=(r: 51; g: 51; b: 51);
  42.  grey90:     color=(r: 57; g: 57; b: 57);
  43.  white:      color=(r: 63; g: 63; b: 63); { maximum intensity }
  44.  red:        color=(r: 63; g: 0;  b: 0 ); { primary colors }
  45.  green:      color=(r: 0;  g: 63; b: 0 );
  46.  blue:       color=(r: 0;  g: 0;  b: 63);
  47.  yellow:     color=(r: 63; g: 63; b: 0 ); { secondary colors }
  48.  cyan:       color=(r: 0;  g: 63; b: 63);
  49.  purple:     color=(r: 63; g: 0;  b: 63);
  50.  orange:     color=(r: 63; g: 32; b: 0 ); { tertiary colors }
  51.  chartreuse: color=(r: 32; g: 63; b: 0 ); { quite uncommon... }
  52.  jade:       color=(r: 0;  g: 63; b: 32);
  53.  robin:      color=(r: 0;  g: 32; b: 63);
  54.  periwinkle: color=(r: 32; g: 0;  b: 63);
  55.  magenta:    color=(r: 63; g: 0;  b: 32); { not typical, but accurate }
  56.  
  57.  color16map: ARRAY[0..15] OF byte =
  58.  (0,1,2,3,4,5,20,7,56,57,58,59,60,61,62,63);
  59.  
  60.  { AssignColor -- sets color INDEX to C }
  61. PROCEDURE AssignColor(index: byte; c: color);
  62.  { SetColors -- mass version of AssignColor...
  63.   Sets n colors, starting at index I and location C in palette P }
  64. PROCEDURE Assign16Color(index: byte; c: color);
  65. PROCEDURE SetColors(p: palette; i,c: byte; n: word);
  66.  { Loads a FractINT-style .MAP file into a palette
  67.   fn is the filename, p is the palette to place it in }
  68. PROCEDURE Set16Colors(p: palette; i,c: byte; n: word);
  69. PROCEDURE LoadColors(fn: STRING; VAR p: palette);
  70.  { Saves a FractINT-style .MAP file from a palette
  71.   fn is the filename, p is the palette to place it in }
  72. PROCEDURE SaveColors(fn: STRING; p: palette);
  73.  { Sets an element by red, green, and blue components...
  74.   c=color to set, r,g,b are % components 0-100 }
  75. PROCEDURE SetRGB(VAR c: color; r,g,b: byte);
  76.  { Sets color by Hue, Saturation, Intensity scale,
  77.   c=color to set, h=hue 0-360, s=saturation 0-100 (100=pure, 0=grey)
  78.   i=intensity 0-100 (0=black, 100=max) }
  79. PROCEDURE SetHSI(VAR c: color; h: word; s,i: byte);
  80.  { Returns the red, green, and blue components,
  81.   c=color to get, r,g,b=red, green, and blue returns }
  82. PROCEDURE GetRGB(c: color; VAR r,g,b: byte);
  83.  { Averages two colors, weighted with percentages.
  84.   p=resulting color
  85.   c1,c2=colors to mix
  86.   p1,p2=percentages of each color. }
  87. PROCEDURE Mix(VAR p,c1: color; p1: byte; c2: color; p2: byte);
  88.  { Rather an odd procedure...
  89.   p=resulting color
  90.   c=color to alter
  91.   t=color to tint c with
  92.   pt=percentage of tint }
  93. PROCEDURE Tint(VAR p: color; c,t: color);
  94.  { Gets the intensity of a color }
  95. FUNCTION Intensity(c: color): byte;
  96.  { Sets the contrast of a color c by pt relative to grey }
  97. PROCEDURE Contrast(VAR p: color; c: color; pt: byte);
  98.  { Uses mix to average over a selection of colors in a palette }
  99. PROCEDURE Range(VAR p: palette; i1,i2: byte);
  100.  { Sets overscan border color to c }
  101. PROCEDURE SetBorder(c: byte);
  102.  
  103. IMPLEMENTATION
  104. USES DOS;
  105. VAR  R : Registers;
  106.  
  107. PROCEDURE AssignColor;
  108. BEGIN
  109.  r.ax:=$1010;
  110.  r.bh:=0;
  111.  r.bl:=index;
  112.  r.dh:=c.r;
  113.  r.ch:=c.g;
  114.  r.cl:=c.b;
  115.  intr($10,r)
  116. END;
  117.  
  118. PROCEDURE Assign16Color;
  119. BEGIN
  120.  r.ax:=$1010;
  121.  r.bh:=0;
  122.  r.bl:=color16map[index];
  123.  r.dh:=c.r;
  124.  r.ch:=c.g;
  125.  r.cl:=c.b;
  126.  intr($10,r)
  127. END;
  128.  
  129. PROCEDURE SetColors;
  130. BEGIN
  131.  r.ax:=$1012;
  132.  r.bh:=0;
  133.  r.bl:=c;
  134.  r.cx:=n;
  135.  r.es:=Seg(p);
  136.  r.dx:=Ofs(p[0])+i*3;
  137.  intr($10,r)
  138. END;
  139.  
  140. PROCEDURE Set16Colors;
  141. VAR t: Palette;
  142.   j: integer;
  143. BEGIN
  144.  FOR j:=1 TO n DO
  145.   t[color16map[j+c-1]]:=p[j+i-1];
  146.  SetColors(t,color16map[i],color16map[c],color16map[c+n-1]-color16map[c]+1)
  147. END;
  148.  
  149. {$I-}
  150. PROCEDURE LoadColors;
  151. VAR f: Text;
  152.   i,r,g,b: byte;
  153. BEGIN
  154.  Assign(f,fn);
  155.  Reset(f);
  156.  FOR i:=0 TO 255 DO
  157.  BEGIN
  158.   readln(f,r,g,b);
  159.   p[i].r:=r div 4;
  160.   p[i].g:=g div 4;
  161.   p[i].b:=b div 4
  162.  END;
  163.  Close(f)
  164. END;
  165.  
  166. PROCEDURE SaveColors(fn: STRING; p: palette);
  167. VAR f: Text;
  168.   i: byte;
  169. BEGIN
  170.  Assign(f,fn);
  171.  Rewrite(f);
  172.  FOR i:=0 TO 255 DO
  173.   writeln(f,p[i].r*4,p[i].g*4,p[i].b*4);
  174.  Close(f)
  175. END;
  176. {$I+}
  177.  
  178. PROCEDURE SetRGB;
  179. BEGIN
  180.  c.r:=r*63 div 100;  { rather simple, really -- just convert % into }
  181.  c.g:=g*63 div 100;  { BIOS mapping 0-63 }
  182.  c.b:=b*63 div 100
  183. END;
  184.  
  185. PROCEDURE GetRGB;
  186. BEGIN
  187.  r:=c.r*100 div 63;
  188.  g:=c.g*100 div 63;
  189.  b:=c.b*100 div 63
  190. END;
  191.  
  192. PROCEDURE SetHSI;
  193. { Completely self-explanatory, in my opinion }
  194. VAR r,g,b,t: real;
  195. BEGIN
  196.  t:=Pi*H/180;
  197.  r:=1+s/100*sin(t-2*pi/3);
  198.  g:=1+s/100*sin(t);
  199.  b:=1+s/100*sin(t+2*pi/3);
  200.  t:=63.999*i/200;
  201.  c.r:=trunc(r*t);
  202.  c.g:=trunc(g*t);
  203.  c.b:=trunc(b*t)
  204. END;
  205.  
  206. PROCEDURE Mix;
  207. BEGIN
  208.  p.r:=(c1.r*p1+c2.r*p2) div 100; { just do a weighted average }
  209.  p.g:=(c1.g*p1+c2.g*p2) div 100;
  210.  p.b:=(c1.b*p1+c2.b*p2) div 100
  211. END;
  212.  
  213. PROCEDURE Tint;
  214. BEGIN
  215.  p.r:=c.r*t.r div 63;   { brings out components, really }
  216.  p.g:=c.g*t.g div 63;
  217.  p.b:=c.b*t.b div 63
  218. END;
  219.  
  220. FUNCTION Intensity;
  221. BEGIN
  222.  Intensity:=(c.r+c.g+c.b)*100 div 191 { really dumb function }
  223. END;
  224.  
  225. PROCEDURE Contrast;
  226. VAR i: byte;
  227. BEGIN
  228.  i:=Intensity(c)*63 div 100;
  229.  p.r:=c.r+(i-c.r)*pt div 100;  { just moves away/closer to grey }
  230.  p.g:=c.g+(i-c.g)*pt div 100;
  231.  p.b:=c.b+(i-c.b)*pt div 100
  232. END;
  233.  
  234. PROCEDURE Range;
  235. VAR i: byte;
  236. BEGIN
  237.  FOR i:=i1 TO i2 DO { simple averaging loop }
  238.   Mix(p[i],p[i1],(i2-i)*100 div (i2-i1),p[i2],(i-i1)*100 div (i2-i1))
  239. END;
  240.  
  241. PROCEDURE SetBorder;
  242. BEGIN
  243.  r.ax:=$1001;
  244.  r.bh:=c;
  245.  intr($10,r);
  246. END;
  247.  
  248. END.